Shareware Super Platinum 8

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / LIB211.ZIP;1 / STATS.PRG < prev next >

Wrap

Text File | 1993-11-19 | 40.8 KB | 1,011 lines

*----------------------------------------------------------------------- *-- Program...: STATS.PRG *-- Programmer: Ken Mayer (CIS: 71333,1030) and *-- Jay Parsons (CIS: 72662,1302) *-- Date......: 07/29/1993 *-- Notes.....: Statistical Functions -- see README.TXT to include this *-- library file in your system. *----------------------------------------------------------------------- FUNCTION Samplevar *----------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 72662,1302) *-- Date........: 04/13/1992 *-- Notes.......: Finds sample variance of specified field of the *-- current database, using CALCULATE command. *-- The CALCULATE command calculates the population *-- variance, which is smaller by a factor of (n-1)/n. *-- Written for.: dBASE IV Version 1.5 *-- Rev. History: Original function 1990. *-- : Modified to take optional parameter, 4/13/1992 *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Samplevar( <cField> [, <cClause> ] ) *-- Example.....: ? Samplevar( "Balance", ".FOR..NOT.; *-- isblank( Balance )" ) *-- Returns.....: a numeric or float value, the sample variance, or *-- .F. if it cannot be calculated. If any of the *-- numeric items are floats, the result will be. *-- Parameters..: cField = name of a numeric field of the current *-- database for which to calculate the sample *-- variance *-- : cClause = optional, a FOR, WHILE, TO, etc. clause *----------------------------------------------------------------------- parameters cField, cCondition private fVar, nCount, cCond if pcount() = 2 m->cCond = " "+ m->cCondition else m->cCond = "" endif calculate var( &cField. ), CNT() TO m->fVar, m->nCount &cCond. RETURN iif( m->nCount > 1, m->fVar * m->nCount / ( m->nCount - 1 ), ; .F. ) *-- Eof: Samplevar() FUNCTION Stny *----------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 72662,1302) *-- Date........: 11/13/1990 *-- Notes.......: Returns value of the standard normal distribution *-- function given a number of standard deviations from *-- the mean. This function is not useful alone. The *-- standard normal distribution function is the familiar *-- bell-shaped curve scaled so its mean is at 0, each *-- standard deviation is 1 and the total area under the *-- curve is 1. The function Stnarea calls on this *-- function to calculate the approximate area (a fraction *-- equal to percent of the total) under the part of the *-- curve lying betwen the mean and the given number of *-- standard deviations. *-- Written for.: dBASE IV *-- Rev. History: 11/13/1990 -- Original Release *-- Calls : None *-- Called by...: Any *-- Usage.......: Stny( <nDevs> ) *-- Example.....: ? Stny( 1 ) *-- Returns : numeric value of the function. *-- Parameters..: nDevs = standard deviations from the mean *----------------------------------------------------------------------- parameters nDevs RETURN exp( -m->nDevs * m->nDevs / 2 ) / sqrt( 2 * pi() ) *-- EoF: Stny() FUNCTION Stnarea *----------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 72662,1302) *-- Date........: 11/13/1990 *-- Notes.......: Area of the standard normal distribution function *-- between mean and given number of standard deviations *-- from the mean. *-- *-- What's it about? Well, College Board scores *-- (originally) were based on a normal distribution with *-- a mean of 500 and 100 points per standard deviation. *-- Knowing that a 650 score is 1.5 standard deviations *-- from the 500 mean, we can calculate Stnarea( 1.5 ) *-- as .4332. This tells us that 43.32% of the scores *-- lie between 650 and 500. Since 50% lie below 500, *-- a score of 650 beats 93.32% of the scores. *-- *-- The polynomial approximation used by this function is *-- said to be accurate to .00001, 1/1000 of one percent. *-- Remember to SET DECIMALS appropriately to view *-- results. *-- *-- Written for.: dBASE IV *-- Rev. History: 11/13/1990 -- Original Release *-- Calls : Stny() Function in STATS.PRG *-- Called by...: Any *-- Usage.......: Stnarea( <nDevs> ) *-- Example.....: ? Stnarea( 1.5 ) *-- Returns : % of area between deviations given and the mean, *-- 0<=a<.5. *-- Parameters..: nDevs = standard deviations from the mean *----------------------------------------------------------------------- parameters nDevs private nX, nV m->nX = abs( m->nDevs ) m->nV = 1 / ( 1 + .33267 * m->nX ) RETURN .5 - Stny( m->nX ) * ( .4361836 * m->nV - .1201676 * m->nV *; m->nV + .937298 * m->nV * m->nV * m->nV ) *-- EoF: Stnarea() FUNCTION Stnz *----------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 72662,1302) *-- Date........: 11/13/1990 *-- Notes.......: A lookup table to find the values of "z", standard *-- deviations, corresponding to the most common areas *-- inside a given number of tails of the normal *-- distribution function. *-- *-- Used in testing confidence intervals. If a sample of *-- light bulbs from a shipment shows an average life of *-- 1150 hours, and the criterion for rejection of the *-- shipment is 95% confidence that the average life of *-- all bulbs is less than (a single tail) 1200 hours, *-- the value 1.64485 returned by this function is *-- necessary to determine whether to reject the shipment *-- or not. *-- *-- Values of "z" that are not found in the table can be *-- found using Stndevs, below, but it is slow. *-- Written for.: dBASE IV *-- Rev. History: 11/13/1990 -- Original Release *-- Calls : None *-- Called by...: Any *-- Usage.......: Stnz( <nProb>, <nTails> ) *-- Example.....: ? Stnz( .95, 1 ) *-- Returns : z = number of standard deviations from mean inside *-- which ( or to the side of which includes the *-- mean, if one tail) the given percentage of area *-- will fall. *-- Returns -1 if no entry in table. *-- Parameters..: nConf = confidence desired, 0 < nConf < 1 *-- nTails = 1 or 2 = number of tails of curve of interest *----------------------------------------------------------------------- parameters nConf, nTails if m->nTails # 1 .and. m->nTails # 2 RETURN -1 endif do case case m->nConf = .95 RETURN iif( m->nTails = 1, 1.64485, 1.96010 ) case m->nConf = .99 RETURN iif( m->nTails = 1, 2.32676, 2.57648 ) case m->nConf = .995 RETURN iif( m->nTails = 1, 2.57648, 2.80794 ) case m->nConf = .999 RETURN iif( m->nTails = 1, 3.09147, 3.29202 ) otherwise RETURN -1 endcase *-- EoF: Stnz() FUNCTION Stndiff *----------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 72662,1302) *-- Date........: 04/13/1992 *-- Notes.......: Determines whether hypothesis that sample of a given *-- mean is different from expected mean is justified. *-- *-- if nPopstd, the standard deviation of the population, *-- is not known and nSample, the sample size, is greater *-- than 30, the sample standard deviation may be used for *-- nPopstd. *-- *-- This function assumes the population is large relative *-- to the sample or that the sampling is with *-- replacement. if neither is true, the right side of the *-- expression in the later return line should be *-- multiplied by: *-- sqrt( ( nPop - nSample ) / ( nPop - 1 ) ) *-- where nPop is the size of the population. *-- *-- Do not use this with small samples, less than 20, *-- because the standard normal distribution is not *-- sufficiently accurate as an approximation of the *-- distribution of sample means in such a case. *-- See "Student's T-distribution" in a statistics text. *-- *-- Written for.: dBASE IV Version 1.5 *-- Rev. History: 04/13/1992 -- Original Release *-- Calls.......: Stnz() Function in STATS.PRG *-- Called by...: Any *-- Usage.......: Stndiff( <m->nConf>, <nTails>, <nSample>,<nSampmean>,; *-- <nPopmean>, <nPopstd> ) *-- Example.....: ? Stndiff( .95, 1, 30, 1150, 1200, 20 ) *-- Returns.....: .T. if hypothesis of difference is justified to degree *-- of confidence specified, or .F. Returns -1 if *-- confidence is not one for which z can be looked up *-- in Stnz(). if you need other confidence levels, *-- run Stndevs() to find the z values for them and add *-- them to the Stnz() table. *-- Parameters..: nConf = confidence desired, 0 < m->nConf < 1 *-- nTails = 1 or 2 = number of tails of curve of *-- interest *-- nSample = number of items in the sample *-- nSampmean = mean of the sample *-- nPopmean = mean of the population (test standard *-- mean) *-- nPopstd = standard deviation of population *----------------------------------------------------------------------- parameters nConf, nTails, nSample, nSampmean, ; nPopmean, nPopstd private nStd m->nStd = Stnz( m->nConf, m->nTails ) if m->nStd = -1 RETURN m->nStd else RETURN abs( m->nSampmean - m->nPopMean ) ; > m->nStd * m->nPopStd / sqrt( m->nSample ) endif *-- EoF: Stndiff() FUNCTION Stndevs *----------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 72662,1302) *-- Date........: 04/13/1992 *-- Notes.......: Calculates "z", standard deviations, corresponding to *-- any area of standard normal curve between mean and the *-- desired z. Much slower than Stnz(). *-- Written for.: dBASE IV Version 1.5 *-- Rev. History: Original function 1990. *-- : Conformed to Zeroin() 4/13/1992. *-- Calls.......: Zeroin() Function in STATS.PRG *-- Called by...: Any *-- Usage.......: Stndevs( <nArea> ) *-- Example.....: ? Stndevs( .96 ) *-- Returns.....: z, number of standard deviations from mean, or a *-- negative number indicating failure to find a root.. *-- Parameters..: nArea = area "left" of point of interest, *-- .5 < nArea < 1 *----------------------------------------------------------------------- parameters nArea private nTest, nFlag if m->nArea > .99999 .OR. m->nArea < .5 RETURN -1 endif m->nFlag = 0 m->nTest = Zeroin( "TstmnArea", 0, 4.2, float(1/100000), 100, ; m->nFlag, m->nArea ) RETURN iif( m->nFlag < 3, m->nTest, -m->nFlag ) *-- EoF: Stndevs() FUNCTION Tstnarea *----------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 72662,1302) *-- Date........: 11/13/1990 *-- Notes.......: Translation function to convert area to left of point *-- : under standard normal curve to 0 for Zeroin(). *-- Written for.: dBASE IV *-- Rev. History: 11/13/1990 -- Original Release *-- Calls.......: Stnarea() Function in STATS.PRG *-- Called by...: Any *-- Usage.......: Tstnarea( <nDevs>, <nArea> ) *-- Example.....: ? Tstnarea( 1.6,.96 ) *-- Returns.....: positive or negative number corresponding to direction *-- to root where nArea = Stnarea *-- Parameters..: nDevs = trial number of standard deviations *-- nArea = area for which deviations are to be found *----------------------------------------------------------------------- parameters nDevs, nArea RETURN Stnarea( m->nDevs ) +.5 - m->nArea *-- EoF: Tstnarea() FUNCTION Zeroin *----------------------------------------------------------------------- *-- Programmer..: Tony Lima (CIS: 72331,3724) and *-- Jay Parsons (CIS: 72662,1302) *-- Date........: 04/13/1992 *-- Notes.......: Finds a zero of a continuous function. *-- In substance, what this function does is close in on a *-- solution to a function that cannot otherwise be *-- solved. Assuming Y = f(X), if Y1 and Y2, the values of *-- the function for X1 and X2, have different signs, *-- there must be at least one value of X between X1 and *-- X2 for which Y = 0, if the function is continuous. *-- This function closes in on such a value of X by a *-- trial-and-error process. *-- *-- This function is very slow, so a maximum number of *-- iterations is passed as a parameter. if the number *-- of iterations is exceeded, the function will fail to *-- find a root. if this occurs, pick different original *-- "X" values, increase the number of iterations or *-- increase the errors allowed. Once an approximate *-- root is found, you can use values of X close on *-- either side and reduce the error allowed to find an *-- improved solution. Also, of course, the signs of Y *-- must be different for the starting X values for the *-- function to proceed at all. *-- *-- NOTE ESPECIALLY - There is NO guarantee that a root *-- returned by this function is the only one, or the most *-- meaningful. It depends on the function that this *-- function calls, but if that function has several *-- roots, any of them may be returned. This can easily *-- happen with such called functions as net present value *-- where the cash flows alternate from positive to *-- negative and back, and in many other "real life" *-- cases. See the discussion of @IRR in the documentation *-- of a good spreadsheet program such as Quattro Pro for *-- further information. *-- *-- The method used by this function is a "secant and *-- bisect" search. The "secant" is the line connecting *-- two X,Y points on a graph using standard Cartesian *-- coordinates. Where the secant crosses the X axis is *-- the best guess for the value of X that will have *-- Y = 0, and will be correct if the function is linear *-- between the two points. The basic strategy is to *-- calculate Y at that value of X, then keep the new X *-- and that one of the old X values that had a Y-value *-- of opposite sign, and reiterate to close in. *-- *-- if the function is a simple curve with most of the *-- change in Y close to one of the X-values, as often *-- occurs if the initial values of X are poorly chosen, *-- repeated secants will do little to find a Y-value *-- close to zero and will reduce the difference in *-- X-values only slightly. In this case the function *-- shifts to choosing the new X halfway between the old *-- ones, bisecting the difference and always reducing *-- the bracket by half, for a while. *-- *-- While this function finds a "zero", it may be used to *-- find an X corresponding to any other value of Y. *-- Suppose the function of X is FUNCTION Blackbox( X ) *-- and it is desired to find a value of X for which *-- f(X) = 7. The trick is to interpose a function *-- between Zeroin() and Blackbox() that will return a *-- 0 to Zeroin() whenever Blackbox() returns 7. *-- By calling that function, Zeroin() finds a value of *-- X for which Blackbox( X ) = 7, as required: *-- Result = Zeroin("Temp", <other parameters omitted>) *-- *-- FUNCTION Temp *-- parameters nQ *-- RETURN Blackbox( nQ ) - 7 *-- Written for.: dBASE IV Version 1.5 *-- Rev. History: Original function 1990. *-- : Modified to take optional parameters, 4/13/1992 *-- Calls.......: The function whose name is first parameter. *-- : NPV() Function in FINANCE.PRG *-- Called by...: Any *-- Usage.......: Zeroin( <cFunction>, <fX1>, <fX2>, <fAbserror>, ; *-- : <nMaxiter>, <n_Flag> ; *-- : [, xPass1 [, xPass2 [, xPass3 ] ] ] ) *-- Example.....: ? Zeroin( "Npv", 0, 200, .000001, 200, n_Flag, 11 ) *-- Returns.....: a float value representing a root, if n_Flag < 3. *-- Parameters..: cFunction = the name of the function to solve for a *-- root. *-- fX1 = one of the X-values between which the *-- root is sought. *-- fX2 = the second of these values. *-- Note: These MUST be chosen so the f( X ) values for *-- the two of them have opposite signs (they must *-- bracket the result). *-- fAbserror = the absolute error allowed in the result. *-- nMaxiter = the maximum number of times to iterate. *-- n_Flag = an integer to signal success ( < 3 ) or *-- failure. *-- xPass1 . . . 3 = arguments to be passed through to *-- cFunction. *-- The parameter "n_Flag" should be passed as a variable *-- so it may be accessed on return. The limit of 9 *-- literal parameters may require passing others as *-- variables. The "xPass" parameters are optional and *-- the fact there are three of them is arbitrary; they *-- exist to hold whatever parameters may be needed by *-- the function cFunction being called aside from the *-- value of X for which it is being evaluated. Add more *-- and change the 3 "&cFunc." lines below if you need *-- more. *-- Side effects: Uses and alters a global numeric variable, here called *-- "n_Flag", to report error conditions resulting in *-- value returned being meaningless. Possible n_Flag *-- values are: *-- 1 success - root found within error allowed *-- 2 success - root was found exactly *-- 3 error - function value not converging *-- 4 error - original values do not bracket a *-- root *-- 5 error - maximum iterations exceeded *----------------------------------------------------------------------- parameters cFunc, fNearx, fFarx, fAbserr, nMaxiter, ; n_Flag, xPass1, xPass2, xPass3 private nSplits, fBracket, fFary, fNeary, nIters private fMaxabs, fOldx, fOldy, fDiffx, fAbsdiff, fSecant store 0 to m->nSplits, m->nIters m->fBracket = abs ( m->fNearX - m->fFarX ) m->fFarY = &cFunc.( m->fFarX, m->xPass1, m->xPass2, m->xPass3 ) m->fNearY = &cFunc.( m->fNearX, m->xPass1, m->xPass2, m->xPass3 ) if sign( m->fNearY ) = sign( m->fFarY ) m->n_Flag = 4 RETURN float(0) endif m->fMaxAbs = max( abs( m->fNearY ), abs( m->fFarY ) ) m->n_Flag = 0 * Main iteration loop do while .t. if abs( m->fFarY ) < abs( m->fNearY ) * Interchange m->fNearX and fFarx so that * m->fNearX is closer to a solution-- * abs( m->fNearY ) <= abs( m->fFarY ) m->fOldX = m->fNearX m->fOldY = m->fNearY m->fNearX = m->fFarX m->fNearY = m->fFarY m->fFarX = m->fOldX m->fFarY = m->fOldY endif m->fDiffX = m->fFarX - m->fNearX m->fAbsDiff = abs( m->fDiffX ) * Test whether interval is too small to continue if m->fAbsDiff <= 2 * m->fAbsErr if abs( m->fNearY ) > m->fMaxAbs * Yes, but we are out of bounds m->n_Flag = 3 m->fNearX = float(0) else * Yes, and we have a solution! m->n_Flag = 1 endif exit endif * Save the last approximation to x and y m->fOldX = m->fNearX m->fOldY = m->fNearY * Check if reduction in the size of * bracketing interval is satisfactory. * if not, bisect until it is. m->nSplits = m->nSplits + 1 if m->nSplits >= 4 if 4 * m->fAbsDiff >= m->fBracket m->fNearX = m->fNearX + m->fDiffX / 2 else m->nSplits = 0 m->fBracket = m->fAbsDiff / 2 * Calculate secant m->fSecant = ( m->fNearX - m->fFarX ) * m->fNearY ; / ( m->fFarY - m->fNearY ) * But not less than error allowed if abs( m->fSecant ) < m->fAbsErr m->fNearX = m->fNearX + m->fAbsErr * sign( m->fDiffX ) else m->fNearX = m->fNearX + m->fSecant endif endif endif * Evaluate the function at the new approximation m->fNearY = &cFunc.( m->fNearX, m->xPass1, m->xPass2, m->xPass3 ) * if it's exactly zero, we win! Run with it if m->fNearY = 0.00 m->n_Flag = 2 exit endif * else adjust iteration count and quit if too * many iterations with no solution m->nIters = m->nIters + 1 if m->nIters > m->nMaxIter m->n_Flag = 5 m->fNearX = float( 0 ) exit endif * And finally keep as the new m->fFarX that one * of the previous approximations, m->fFarX and * fOldx, at which the function has a sign opposite * to that at the new approximation, fNearx. if sign( m->fNearY ) = sign( m->fFarY ) m->fFarX = m->fOldX m->fFarY = m->fOldY endif enddo RETURN m->fNearX *-- EoF: Zeroin() FUNCTION Median *----------------------------------------------------------------------- *-- Programmer..: Oktay Amiry (Borland Technical Support) *-- Date........: 12/01/1992 *-- Notes.......: Median refers to the middle value in a list; it is the *-- halfway point from the lowest value to the highest. *-- This was published in TechNotes, December 1992 issue. *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 12/01/1992 -- Original Release *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Median(<nField>) *-- Example.....: ?Median("SCORE") *-- Returns.....: Character value *-- Parameters..: nField = an indexed numeric field name in the current *-- database *----------------------------------------------------------------------- parameters nField private nCount, lEven,cLow,cHigh,cMed do case case isblank(dbf()) RETURN "No database is in use" case tagcount() = 0 RETURN "Specified file must be indexed" case type(m->nField) # "N" RETURN "Specified field must be numeric" case upper(key()) # upper(m->nField) m->nCount = 1 do while m->nCount <= tagcount() if upper(key(m->nCount)) # upper(m->nField) m->nCount = m->nCount + 1 else set order to tag(m->nCount) exit endif enddo if upper(key(m->nCount)) # upper(m->nField) RETURN "Specified field must be indexed" endif endcase go top m->lEven = mod(reccount(),2) = 0 if m->lEven skip ((reccount()/2) -1) m->cLow = ltrim(str(&nField.)) skip m->cHigh = ltrim(str(&nField.)) else skip int(reccount()/2) m->cMed = ltrim(str(&nField.)) endif RETURN iif(m->lEven,m->cLow+" TO "+m->cHigh,m->cMed) *-- EoF: Median() FUNCTION Mode *----------------------------------------------------------------------- *-- Programmer..: Oktay Amiry (Borland Technical Support) *-- Date........: 12/01/1992 *-- Notes.......: Used to determine the item which occurs most *-- frequently in a list. *-- Printed in TechNotes, December 1992. *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 12/01/1992 -- Original Release *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Mode(<xField>) *-- Example.....: ?Mode("SEX") *-- Returns.....: The item that is the most common among those in that *-- field. *-- Parameters..: xField = an indexed field (it must be indexed) *----------------------------------------------------------------------- parameters xField private nCount,nMem,nOccur,nHigh,nName do case case tagcount() = 0 RETURN "Specified file must be indexed" case reccount() <= 1 RETURN "Invalid number of records for MODE()" *case type(m->xField) # "N" *RETURN "Specified field must be Numeric" endcase if upper(order()) # upper(m->xField) RETURN "Specified field must be indexed" endif go top m->nHigh = 1 m->nCount = 0 scan m->xCurrent = &xField. m->xSame = &xField. scan while m->xCurrent = m->xSame m->xCurrent = &xField. if m->xCurrent = m->xSame m->nCount = m->nCount + 1 endif endscan if m->nCount > m->nHigh m->nHigh = m->nCount m->xReturn = m->xSame else if m->nCount = m->nHigh m->xReturn = -1 endif endif m->nCount = 0 endscan RETURN iif(m->nHigh = 1, -1, m->xReturn) *-- EoF: Mode() FUNCTION Prcntl *----------------------------------------------------------------------- *-- Programmer..: Oktay Amira (Borland Technical Support) *-- Date........: 12/01/1992 *-- Notes.......: Returns the percentile ranking of a number compared to *-- a list. Printed in TechNotes, December 1992. *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 12/01/1992 *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Prcntl(<nField>,<nrank>) *-- Example.....: ?Prcntl("SCORE",90) *-- Returns.....: numeric *-- Parameters..: nField = a numeric field in a database *-- nRank = number to be ranked. *----------------------------------------------------------------------- parameters nField,nRank private nField,nRank,nPercentile count to m->nPercentile for m->nRank > &nField. RETURN (m->nPercentile * 100) / reccount() *-- EoF: Prcntl() FUNCTION Range *----------------------------------------------------------------------- *-- Programmer..: Oktay Amira (Borland Technical Support) *-- Date........: 12/01/1992 *-- Notes.......: Returns a number representing the difference between *-- the highest and lowest numbers of a list. *-- Originally printed in TechNotes, Dec. 1992 *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 12/01/1992 -- Original Release *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Range(<nField>) *-- Example.....: ?Range("SCORE") *-- Returns.....: Numeric *-- Parameters..: nField = a numeric field in an open database *----------------------------------------------------------------------- parameters nField private nHigh,nLow calculate max(&nField.) to m->nHigh, min(&nField.) to m->nLow RETURN (m->nHigh - m->nLow) *-- EoF: Range() FUNCTION RMS *----------------------------------------------------------------------- *-- Programmer..: Oktay Amira (Borland Technical Support) *-- Date........: 12/01/1992 *-- Notes.......: Root-Mean-Square can be applied to any numeric list *-- (ordinal, interval, and ratio) to find the overall *-- size of the numbers in the list, in lieu of their *-- signs. *-- Printed in TechNotes, December 1992. *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 12/01/1992 -- Original Release *-- Calls.......: None *-- Called by...: Any *-- Usage.......: RMS(<nField>) *-- Example.....: ?RMS("SCORE") *-- Returns.....: numeric *-- Parameters..: nField = a numeric field *----------------------------------------------------------------------- parameters nField private nTotal calculate sum(&nField. ^ 2) to m->nTotal RETURN sqrt((m->nTotal/reccount())) *-- EoF: RMS() FUNCTION SD *----------------------------------------------------------------------- *-- Programmer..: Oktay Amira (Borland Technical Support) *-- Date........: 12/01/1992 *-- Notes.......: Standard Deviation -- similar to the dBASE STD *-- function. The standard deviation shows how far away *-- numbers on a list are from their average. The value *-- yielded by standard deviation is in the same units as *-- the numbers which are used to calculate the SD. The *-- SD() function can take two forms: an unbiased (n-1) *-- method and the biased (n-method) form. The SD() *-- function, by default, takes the biased form, which is *-- the standard deviation for a population based on the *-- entire population. With the explicit second parameter *-- being "S", the SD() performs the unbiased method, *-- which is the standard deviation for a population that *-- is based on a sample. This latter method, which is *-- also referred to as the SD+, is usually the value *-- produced by statistical calculators and is frequently *-- higher than population-based SD. *-- Printed in TechNotes, December 1992. *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 12/01/1992 -- Original Release *-- Calls.......: None *-- Called by...: Any *-- Usage.......: SD(<nField>[,"S"]) *-- Example.....: ?SD("SCORE","S") *-- Returns.....: numeric *-- Parameters..: nField = a numeric field *----------------------------------------------------------------------- parameters nField, cType private nAverage, nEntry calculate avg(&nField. ^ 2) to m->nEntry, ; avg(&nField.) to m->nAverage m->nAverage = m->nAverage ^ 2 RETURN iif(type("CTYPE") = "C" .and. upper(cType) = "S",; sqrt(m->nEntry-m->nAverage)/sqrt((reccount()-1)/reccount()),; sqrt(m->nEntry-m->nAverage)) *-- EoF: SD() FUNCTION SU *----------------------------------------------------------------------- *-- Programmer..: Oktay Amira (Borland Technical Support) *-- Date........: 12/01/1992 *-- Notes.......: Standard Units is a unit of measurement often referred *-- to in various statistical calculations. Suffice it to *-- note that SU is an intrinsic way of looking at data, *-- indicating whether a value is above or below the *-- average. A positive SU indicates the value was above *-- average, while a negative SU indicates a below average *-- value. *-- Printed in TechNotes, December 1992. *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 12/01/1992 -- Original Release *-- Calls.......: None *-- Called by...: Any *-- Usage.......: SU(<nField>,<nConvert>) *-- Example.....: ?RMS("SCORE",75) *-- Returns.....: numeric *-- Parameters..: nField = a numeric field *-- nConvert = number to be converted *----------------------------------------------------------------------- parameters nField,nNum private nAverage,nStandard calculate avg(&nField.) to m->nAverage, ; std(&nField.) to m->nStandard RETURN iif(m->nStandard # 0,(nNum-m->nAverage)/m->nStandard,0) *-- EoF: SU() FUNCTION CoEf *----------------------------------------------------------------------- *-- Programmer..: Oktay Amira (Borland Technical Support) *-- Date........: 12/01/1992 *-- Notes.......: Correlation CoEfficiant -- uses as parameters the *-- field names of two numeric fields representing two *-- data sets. Both of these fields must belong to one *-- database. The value returned is always between *-- +1 and -1. *-- Printed in TechNotes, December 1992. *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 12/01/1992 -- Original Release *-- Calls.......: None *-- Called by...: Any *-- Usage.......: CoEf(<nField1>,<nField2>) *-- Example.....: ?CoEf("SCORE","MIDTERM") *-- Returns.....: numeric *-- Parameters..: nField1 = a numeric field *-- nField2 = second numeric field *----------------------------------------------------------------------- parameters nField1, nField2 private nTotal, n1Avg, n1Std, n2Avg, n2Std m->nTotal = 0 calculate avg(&nField1.) to m->n1Avg,; std(&nField1.) to m->n1Std,; avg(&nField2.) to m->n2Avg,; std(&nField2.) to m->n2Std scan m->nTotal - m->nTotal + (&nField1. * &nField2.) endscan RETURN ( (m->nTotal/reccount()) - (m->n1Avg * m->n2Avg) ) / ; (m->n1Std * m->n2Std) *-- EoF: CoEf() FUNCTION Choose *----------------------------------------------------------------------- *-- Programmer..: Oktay Amira (Borland Technical Support) *-- Date........: 12/01/1992 *-- Notes.......: Returns the nth item in a list. The UDF assumes that *-- items in the list are separated by commas. *-- Printed in TechNotes, December 1992. *-- Written for.: dBASE IV, 1.5 *-- Rev. History: 12/01/1992 -- Original Release *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Choose(<cList>,<nItem>[,<cDelimiter>]) *-- Example.....: ?Choose("A,B,C",2) or *-- ?Choose(TIME(),1,":") *-- Returns.....: Character *-- Parameters..: cList = List of items, normally separated by *-- commas (see optional parameter to change *-- delimiter) *-- nItem = item position in list *-- cDelimiter = optional -- if other than a comma is used *-- to separate items in the list, define it *-- here. *----------------------------------------------------------------------- parameter cList, nItem, cDelimiter do case case pcount() < 2 RETURN "Invalid number of parameters" case type("m->cList") # "C" RETURN "First parameter must be character" case type("m->nItem") # "N" RETURN "Second parameter must be numeric" case type("m->cDelimiter") = "L" .and. m->cDelimiter RETURN "Third parameter must be character or empty" case type("m->cDelimiter") = "L" .and. .not. m->cDelimiter m->cDelimiter = "," if .not. m->cDelimiter $ m->cList RETURN "Wrong or missing delimiters in parameter" endif case type("m->cDelimiter") = "C" .and. .not. ; m->cDelimiter $ m->cList RETURN "First parameter is missing specified delimiter" endcase m->nCom = 1 m->nBegin = 1 m->nEnd = 1 do while m->nEnd <= len(trim(m->cList)) if substr(m->cList,m->nEnd,1) # m->cDelimiter m->nEnd = m->nEnd + 1 else if m->nCom # m->nItem m->nCom = m->nCom + 1 m->nEnd = m->nEnd + 1 m->nBegin = m->nEnd else m->nEnd = m->nEnd - m->nBegin exit endif endif enddo RETURN substr(m->cList,m->nBegin,m->nEnd) *-- EoF: Choose() *----------------------------------------------------------------------- *-- The functions below are here by courtesy ... (to make life easier on *-- the poor programmer ...) *----------------------------------------------------------------------- FUNCTION Npv *----------------------------------------------------------------------- *-- Programmer..: Tony Lima (CIS: 72331,3724) and *-- Jay Parsons (CIS: 72662,1302) *-- Date........: 03/01/1992 *-- Notes.......: Net present value of array aCashflow[ nPeriods ] *-- Calculates npv given assumed rate and # periods. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 03/01/1992 -- Original Release *-- Calls.......: None *-- Called by...: Any *-- Usage.......: NPV(<nRate>,<nPeriods>) *-- Example.....: ? NPV( .06, 6 ) *-- Returns.....: Float = value of the project at given rate *-- Parameters..: nRate = Interest Rate *-- nPeriods = Number of Periods to calculate for *-- Other inputs: Requires the array aCashflow[ ] set up before calling. *-- Each of its elements [n] holds the cash flow at the *-- beginning of period n, with a negative amount *-- indicating a cash outflow. Elements of value 0 must *-- be included for all periods with no cash flow, and *-- all periods must be of equal length. If the project *-- is expected to require an immediate outlay *-- of $6,000 and to return $2,000 at the end of each of *-- the first five years thereafter, the array will be: *-- aCashflow[1] = -6000 *-- aCashflow[2] = 2000 *-- aCashflow[3] = 2000 *-- * * * *-- aCashflow[6] = 2000 *-- Rewriting function to have array name passed as a *-- parameter is possible, but will slow down execution to *-- an extent that will be very noticeable if this *-- function is being repeatedly executed, as by Zeroin() *-- to find an Internal Rate of Return. *----------------------------------------------------------------------- parameters nRate, nPeriods private nDiscount, nFactor, nPeriod, nNpv m->nPeriod = 1 m->nNPV = aCashflow[ 1 ] m->nDiscount = float( 1 ) m->nFactor = 1 / ( 1 + nRate ) do while m->nPeriod < m->nPeriods m->nPeriod = m->nPeriod + 1 m->nDiscount = m->nDiscount * m->nFactor m->nNPV = m->nNPV + aCashflow[ m->nPeriod ] * m->nDiscount enddo RETURN m->nNPV *-- EoF: Npv() FUNCTION ArrayRows *----------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 72662,1302) *-- Date........: 03/01/1992 *-- Notes.......: Number of Rows in an array *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 03/01/1992 -- Original Release *-- Calls.......: None *-- Called by...: Any *-- Usage.......: ArrayRows("<aArray>") *-- Example.....: n = ArrayRows("aTest") *-- Returns.....: numeric *-- Parameters..: aArray = Name of array *----------------------------------------------------------------------- parameters aArray private nHi, nLo, nTrial, nDims m->nLo = 1 m->nHi = 1170 if type( "&aArray.[ 1, 1 ]" ) = "U" m->nDims = 1 else m->nDims = 2 endif do while .T. m->nTrial = int( ( m->nHi + m->nLo ) / 2 ) if m->nHi < m->nLo exit endif if m->nDims = 1 .and. type( "&aArray.[ m->nTrial ]" ) = "U" .or.; m->nDims = 2 .and. type( "&aArray.[ m->nTrial, 1 ]" ) = "U" m->nHi = m->nTrial - 1 else m->nLo = m->nTrial + 1 endif enddo RETURN m->nTrial *-- EoF: ArrayRows() *----------------------------------------------------------------------- *-- End of Program: STATS.PRG *-----------------------------------------------------------------------